home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / comm / fido / SHELTER275.lha / rexx / Read.rexx < prev    next >
OS/2 REXX Batch file  |  1995-04-17  |  7KB  |  232 lines
  1. /**/
  2. v="$VER: Read  Rexx Message Base Browser Williamson 55.08"
  3. tview="Extract"
  4. /*tview="less -[cli]"   */
  5. bbslist="CFG:READ.CFG"
  6. script="Multi-Network Reader";sv="v"||right(v,5)
  7. cr='0a'x;lf='0a'x;NL='0d'x||'0a'x;cls='0C'x||'0A'x;quote='"'
  8. log=show('p','ROOFLOG')
  9. temp="ram:"
  10. timeouts=0
  11. if ~show("L", "rexxsupport.library") then
  12.     if ~addlib("rexxsupport.library", 0, -30, 0) then do
  13.             say "Couldn't access support.library !"
  14.             exit 20
  15.     end
  16. if ~show("L", "rexxdossupport.library") then
  17.     if ~addlib("rexxdossupport.library", 0, -30, 2) then do
  18.             say "Couldn't access WB2 rexxdossupport.library !"
  19.             exit 20
  20.     end
  21.  
  22. options results
  23. options failat 20
  24. signal on halt
  25. signal on ioerr
  26. signal on break_c
  27. signal on break_d
  28.  
  29. if arg()=0 then do
  30.     debug=1
  31.     username="Beta Tester"
  32. end;else do
  33.     debug=0
  34.     baseport=GetClip('SHELTER')
  35.     if baseport="ROOF" then envpath="";else envpath=baseport"/"
  36.     auxdev=GetVar(envpath||'AUXDEV',"G")
  37.     auxmount=GetVar(envpath||'AUXMOUNT',"G")
  38.     devname=delstr(auxdev,pos(":",auxdev))
  39.     if ~showlist("H",devname) then do
  40.         options failat 99999
  41.         ADDRESS COMMAND auxmount
  42.         options failat 20
  43.     end
  44.     parse arg baud port username
  45.     Address VALUE baseport||port
  46.     'String $(device) $(unit) $(locked) $(baudlocked)'
  47.     parse var RESULT device unit locked baudlocked
  48.     if log then address 'ROOFLOG' 'logline' left(time(),5) script': REDIRECT:'device unit locked baudlocked
  49.     if locked="TRUE" then redirect=GetVar(envpath||'AUXDIRECT',"G")||strip(device)'/'strip(unit)'/con/shared/checkcd/speed'||strip(baudlocked)
  50.     else redirect=GetVar(envpath||'AUXDIRECT',"G")||strip(device)'/'strip(unit)'/con/shared/checkcd/speed'||strip(baud)
  51.     if log then address 'ROOFLOG' 'logline' left(time(),5) script': REDIRECT:'redirect
  52. end
  53. /* Start Area Processing */
  54. if ~open('dlst',bbslist, 'R') then do
  55.     call send("SYSTEM ERROR: Couldn't open message areas list" bbslist||NL)
  56.     exit 10
  57. end
  58. x=upper(uprompt(' ANSI? (y/N) '))
  59. ansi=x=="Y"
  60. if ansi then do
  61. CSI='1b'x||'[';AOFF=CSI||'0m';BOLD=CSI||'1m';ITALICS=CSI||'3;40m'
  62. end;else do
  63. CSI='';AOFF='';BOLD='';ITALICS=''
  64. end
  65.  
  66. call send(cls||ITALICS||" "script sv||AOFF||NL||BOLD||" by Robert Williamson 1:167/104.0@fidonet"||AOFF||NL)
  67. /* Start Area Processing */
  68.  
  69. call send(' Reading All Network Message Areas Configuration.')
  70. area=1
  71. do while ~eof('dlst')
  72.     call send('.')
  73.     ln=strip(readln('dlst'))
  74.     if ln="" then iterate
  75.     parse var ln Path.area Network.area Name.area
  76.     if Name.area="" then do
  77.         Name.area=get_fn(Path.area)
  78.         Network.area="FreeNet"
  79.     end;else do
  80.         Name.area=strip(Name.area)
  81.         Tag.area=get_fn(Path.area)
  82.     end
  83.     area=area+1   
  84. end /*eof*/
  85. call close('dlst')
  86. areas=area-1  
  87. call send(NL||' Found 'areas' message areas'||NL)
  88.  
  89. maincmd:
  90. ucmd=uprompt(' Select Area Number, [L]ist areas, [Q]uit: ')
  91. x=upper(left(ucmd,1))
  92. if x="Q" then exit 0
  93. else if datatype(ucmd,"N") & ucmd<areas+1 then do
  94.     call showarea(ucmd)
  95.     signal maincmd
  96. end;else if x="L" then do
  97.     call send(cls)
  98.     display=1
  99.     do i=1 to areas
  100.         if length(i)=1 then call send("  "i"  "ITALICS||Left_justify(Name.i,35)||AOFF||BOLD||left_justify(Tag.i,30)||AOFF||NL)
  101.         else call send(" "i"  "||ITALICS||Left_justify(Name.i,35)||AOFF||BOLD||left_justify(Tag.i,30)||AOFF||NL)
  102.         display=display+1
  103.         if display>20 then do
  104.             ucmd=uprompt(' Select Area Number, [N]ext, [P]revious or [Q]uit: ')
  105.             if datatype(ucmd,"N") & ucmd<areas+1 then do
  106.                 call showarea(ucmd)
  107.                 signal maincmd
  108.             end
  109.             x=upper(left(ucmd,1))
  110.             if x="Q" then exit 0
  111.             else if x="N" | x="" then do
  112.                 call send(cls)
  113.                 display=1
  114.             end;else if x="P" then do
  115.                 call send(cls)
  116.                 if i>40 then i=i-40;else i=0
  117.                 display=1
  118.             end;else do
  119.                 call send('Invalid'||NL)
  120.                 signal maincmd
  121.             end
  122.         end
  123.     end
  124.     signal maincmd
  125. end
  126. signal maincmd
  127. exit 0
  128.  
  129. showarea:
  130.     area=arg(1)
  131.     path=addslash(Path.area)
  132.     call send(cls||' Scanning 'ITALICS||Network.area||AOFF' Area:'area BOLD||Name.area||AOFF)
  133.     x=showdir(Path.area,'F')
  134.     h=0
  135.     do i=1 to words(x)
  136.         nx=word(x,i)
  137.         if pos('.MSG',nx)=0 then iterate
  138.         parse var nx n '.MSG'
  139.         if n>h then h=n
  140.     end
  141.     drop x nx n
  142.     call Send(ITALICS||'    Highest:'AOFF||BOLD||h||AOFF||NL)
  143. gstart:    
  144.     mstart=uprompt(' Enter Starting Message number or [Q}uit: ')
  145.     if upper(left(mstart,1))="Q" then return
  146.     if ~datatype(mstart,"N") then signal gstart
  147.     if mstart>h | ~exists(Path||mstart||'.MSG') then do
  148.         call send(' Cannot find message 'mstart', try again'NL)
  149.         signal gstart
  150.     end
  151. gend:
  152.     mend=uprompt(' Enter Ending message or [Q]uit: ')
  153.     if upper(left(mend,1))="Q" then return
  154.     if ~datatype(mend,"N") then signal gend
  155.     if mend>h | ~exists(path||mend||'.MSG') then do
  156.         call send(' Cannot find message 'mend', highest is 'h||NL)
  157.         signal gend
  158.     end
  159.     if debug then cmd=tview Path' START 'mstart' END 'mend 
  160.     else cmd=tview redirect Path' START 'mstart' END 'mend 
  161.     address COMMAND cmd
  162.     if RC~=0 then signal gstart
  163. return
  164.  
  165. send:
  166.     if debug then call writech(STDOUT,arg(1))
  167.     else do
  168.         'Print' quote||arg(1)||quote
  169.         'Send' quote||arg(1)||quote
  170.     end
  171. return
  172.  
  173. uprompt:
  174. if debug then do
  175.     options prompt arg(1)
  176.     parse pull x
  177.     return x
  178. end;else do
  179.     'Print' quote||arg(1)||quote
  180.     'Send' quote||arg(1)||quote
  181.     'GetInbound E0 30'
  182.     'String $(event)'
  183.     if upper(RESULT)='CARRIER' then exit 10
  184.     else if upper(RESULT)='TIMEOUT' then do
  185.         timeouts=timeouts+1
  186.         if timeouts>3 then do
  187.             call send(' Sorry, too many timeouts, bye')
  188.             exit 10
  189.         end
  190.     end;else if upper(RESULT)='LOGIN' then do
  191.         'String $(namebuf)'
  192.         x=(RESULT)
  193.     end;else x=""
  194. end
  195. return x
  196.  
  197. get_fn:
  198. if LastPos('/',arg(1))~=0 then return SubStr(arg(1),LastPos('/',arg(1))+1)
  199. else if LastPos(':',arg(1))~=0 then return SubStr(arg(1),LastPos(':',arg(1))+1)
  200. else return arg(1)
  201.  
  202. addslash:
  203. curr=arg(1)
  204. select
  205.     when right(curr, 1)=":" then nop
  206.     when right(curr, 1)="/" then nop
  207.     otherwise curr=curr"/"
  208. end
  209. return curr
  210.  
  211. /* a useful procedure by Walt Sullivan  */
  212. dequote:
  213. parse arg thing
  214. parse var thing '"' unq_thing '"'
  215. if unq_thing ~= "" then return unq_thing
  216. return thing
  217.  
  218. right_justify:
  219. if length(arg(1))>arg(2) then return (right(arg(1),arg(2)))
  220. else return (copies(" ",arg(2)-length(arg(1)))||arg(1))
  221.  
  222. left_justify:
  223. if length(arg(1))>arg(2) then return (left(arg(1),arg(2)))
  224. else return (arg(1)||copies(" ",arg(2)-length(arg(1))))
  225.  
  226. halt:
  227. ioerr:
  228. break_c:
  229. break_d:
  230. exit 10
  231. /**/
  232.